home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d17 / slash0.arc / SLASH0.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-01-20  |  12.6 KB  |  372 lines
  1. PROGRAM SLASH0;     {Copyright 1989 by E.C. Weber}
  2.                     {All rights reserved}
  3.                     {Version 1.1 adds left margin feature     01/14/89}
  4. USES  PRINTER,
  5.       CRT;
  6.  
  7. TYPE   String4=STRING[4];
  8.  
  9. VAR   Param:ARRAY[1..4] OF String4        {command line parameter};
  10.       i: INTEGER;                         {counter}
  11.       Margin: REAL;                       {left margin in Pica characters}
  12.       InMargin: REAL;                     {left margin in inches}
  13.       Result: INTEGER;  {needed for syntax but not used in the program}
  14.       CheckBreak:BOOLEAN;
  15.  
  16. PROCEDURE ErrorMessage;
  17.  BEGIN {ErrorMessage}
  18.       WRITELN('SLASH0 [parameter1] [parameter2] [parameter3] [parameter4]');
  19.       WRITELN;
  20.       WRITELN('Where [parameter1] is D for draft, S for Sans Serif, R for Roman, or H for');
  21.       WRITELN('Help.  [parameter2] is 10, 12, or PS.  [parameter3] is N for normal or C for');
  22.       WRITELN('Condensed.  If [parameter3] is omitted, Normal is the default.  [parameter4]');
  23.       WRITELN('is the left margin in inches.  [parameter4] can have a value between 0 and 4.5;');
  24.       WRITELN('if it is omitted, the default is 1.0 inch.  If all parameters are omitted, the');
  25.       WRITELN('defaults are equivalent to SLASH0 D 12 N 1.',#13,#10);
  26.       IF (COPY(Param[1],1,1) <>'H') THEN HALT;
  27.  END{ErrorMessage};
  28.  
  29.  
  30. PROCEDURE Help;
  31.  BEGIN{Help}
  32.       ClrScr;
  33.       FOR i:=1 TO 80 DO WRITE('=');
  34.       WRITELN('                  SLASH0.EXE FOR THE EPSON LQ-850 AND COMPATIBLES');
  35.       WRITELN('                  by Ed Weber          Ver 1.1              c1989');
  36.       FOR i:=1 TO 80  DO WRITE('=');
  37.       WRITELN('The program is executed at the DOS prompt by typing: '#10,#13);
  38.       WRITE('        ');
  39.       ErrorMessage;
  40.       WRITELN('15 CPI is not supported.  Proportional spacing may or may not be satisfactory,') ;
  41.       WRITELN('depending on the application driver. The program selects the font style, pitch,');
  42.       WRITELN('and condensed/normal from the parameters and sends the proper codes to the');
  43.       WRITELN('printer.  ESC % 1, the code required to activate the RAM character set, is sent');
  44.       WRITELN('to the printer; however, the printer drivers in many applications cancel this') ;
  45.       WRITELN('code when they initialize the printer.  In this case, it will be necessary to');
  46.       WRITELN('re-send ESC % 1 to the printer from within the application, embedded at the');
  47.       WRITELN('top of document.');
  48.       HALT;
  49.  
  50.  END{Help};
  51.  
  52. PROCEDURE CheckParam (CheckParam1:String4;CheckParam2:String4;
  53.                       CheckParam3:String4;CheckParam4:String4;
  54.                       LeftMargin:INTEGER);
  55.  
  56.  
  57.   VAR i:INTEGER; {counter}
  58.       MarginError:BOOLEAN;
  59.       PitchError:BOOLEAN;
  60.       FontError:BOOLEAN;
  61.       SizeError:BOOLEAN;
  62.  
  63.  BEGIN {CheckParam}
  64.      MarginError:=FALSE; PitchError:=TRUE;
  65.      FontError:=TRUE;  SizeError:=TRUE;
  66.  
  67.       IF (CheckParam1='D') OR (CheckParam1='S') OR (CheckParam1='R') THEN
  68.             FontError:=FALSE;
  69.  
  70.       IF (CheckParam2='10')OR(CheckParam2='12')OR(CheckParam2='PS') THEN
  71.              PitchError:=FALSE;
  72.  
  73.       IF (CheckParam3='N') OR (CheckParam3='C') THEN
  74.              SizeError:=FALSE;
  75.  
  76.      FOR i:= 1 TO LENGTH(CheckParam4) DO
  77.         BEGIN
  78.          IF((COPY(CheckParam4,i,1)>'9') OR (COPY(CheckParam4,i,1)<'0'))AND
  79.            NOT(COPY(CheckParam4,i,1)='.') THEN
  80.            MarginError:=TRUE;
  81.         END;
  82.  
  83.  
  84.           IF (LeftMargin>45) OR PitchError OR MarginError OR FontError
  85.              OR SizeError THEN
  86.                 BEGIN
  87.                   WRITE('Error in:');
  88.                      IF FontError THEN WRITE(' [parameter1]');
  89.                      IF PitchError THEN WRITE(' [parameter2]');
  90.                      IF SizeError THEN WRITE(' [parameter3]');
  91.                      IF (LeftMargin>45) THEN WRITE(' [margin value]');
  92.                      IF MarginError THEN WRITE(' [margin parameter]');
  93.                   WRITELN;
  94.                   WRITELN;
  95.                   WRITELN('Correct form is:');
  96.                   WRITELN;
  97.                   SOUND(800);DELAY(500);NOSOUND;
  98.                   ErrorMessage;
  99.                 END;
  100.  END {CheckParam};
  101.  
  102.  
  103. PROCEDURE TestPrinter;  {Is it on or off?  NB: This is not a printer status}
  104.                         {check.  It will not detect paper-out or off-line  }
  105. VAR   a:CHAR;           {conditions}
  106.  
  107. BEGIN{TestPrinter}
  108.      {$i-}
  109.      WRITE(LST,#0);
  110.      IF IORESULT<>0 THEN
  111.         BEGIN{printer off}
  112.            Sound(800);Delay(500);NoSound;
  113.            WRITELN(#10,#13,'Printer is Off');
  114.            WRITELN('Turn On Printer then Press <ENTER> to continue or');
  115.            WRITELN('Any other key to quit');
  116.            a:=READKEY;
  117.             IF a=#13 THEN TestPrinter
  118.             ELSE HALT
  119.         END;{printer off}
  120. END;{TestPrinter}
  121.  
  122.  
  123. PROCEDURE Draft;
  124.    BEGIN{Draft}
  125.      WRITE('Draft ');
  126.      IF Param[2]='PS' THEN Param[2]:='12';        {there is no draft ps}
  127.      WRITE(LST,#27,'x'#0);                        {select draft}
  128.      IF Param[2]='10' THEN
  129.        BEGIN
  130.          WRITE(LST,#27,'P');  {select 10 CPI}
  131.          WRITE ('10 CPI');
  132.        END;
  133.      IF Param[2]='12' THEN
  134.        BEGIN
  135.          WRITE(LST,#27,'M');  {select 12 CPI}
  136.          WRITE('12 CPI');
  137.        END;
  138.      WRITE(LST,#$1B,':',#0,#0,#0);            {load rom into ram}
  139.      WRITE(LST,#$1B,'&',#0,'00');             {state which characters}
  140.      WRITE(LST,#1,#9,#2);                     {how many bytes of data?}
  141.  
  142.  {data which describes the character follows}
  143.      WRITE(LST,
  144.    {Column 1}  #1,#253,#0,
  145.           {2}  #6,#2,#192,
  146.           {3}  #8,#4,#32,
  147.           {4}  #16,#8,#16,
  148.           {5}  #8,#16,#32,
  149.           {6}  #16,#32,#16,
  150.           {7}  #8,#64,#32,
  151.           {8}  #6,#128,#192,
  152.           {9}  #1,#127,#0);
  153.      END;{Draft}
  154.  
  155.  
  156. PROCEDURE LetterQual;
  157.    BEGIN{LetterQual}
  158.      WRITE(LST,#27,'&',#0,'00');           {state which characters}
  159.      WRITE(LST,#3,#23,#3);                 {how many bytes of data?}
  160.  
  161.  {data which describes the character follows.  It is broken into two}
  162.  {lines to accomodate the TURBO PASCAL 5.0 debugger}
  163.      WRITE(LST,
  164.     {Column 1} #1,#255,#0,
  165.            {2} #2,#0,#128,
  166.            {3} #5,#255,#64,
  167.            {4} #10,#0,#160,
  168.            {5} #4,#3,#64,
  169.            {6} #24,#0,#48,
  170.            {7} #0,#6,#0,
  171.            {8} #16,#0,#16,
  172.            {9} #32,#12,#8,
  173.           {10} #16,#0,#16,
  174.           {11} #32,#24,#8);
  175.       WRITE(LST,
  176.           {12} #16,#0,#16,
  177.           {13} #32,#48,#8,
  178.           {14} #16,#0,#16,
  179.           {15} #32,#96,#8,
  180.           {16} #16,#0,#16,
  181.           {17} #0,#192,#0,
  182.           {18} #24,#0,#48,
  183.           {19} #5,#128,#64,
  184.           {20} #10,#0,#160,
  185.           {21} #5,#255,#64,
  186.           {22} #2,#0,#128,
  187.           {23} #1,#255,#0);
  188.      END;{LetterQual}
  189.  
  190.  
  191. FUNCTION UpperCase(ParamX:String4):String4; {convert any letters in}
  192.                                             {Params to uppercase   }
  193.  
  194.    VAR   Temp1:String4;   {variables to temporarily hold parameters}
  195.          Temp2:String4;   {during processing}
  196.          i:INTEGER;
  197.  
  198.    BEGIN {UpperCase}
  199.          Temp1:='';
  200.          Temp2:='';
  201.  
  202.            FOR i:=1 TO length(ParamX) DO
  203.              BEGIN
  204.                Temp1:=COPY(ParamX,i,1);
  205.                Temp2:=Temp2 + UPCASE(Temp1[1]);
  206.              END;
  207.      UpperCase:=Temp2
  208.     END;{UpperCase}
  209.  
  210.  
  211. PROCEDURE SelectPitch (PitchParam:String4);
  212.    BEGIN{SelectPitch}
  213.          IF PitchParam='10' THEN
  214.             BEGIN
  215.                WRITE(LST,#27,'P');        {select 10 CPI}
  216.                WRITE(' 10 CPI');
  217.              END;
  218.          IF PitchParam='12' THEN            {select 12 CPI}
  219.              BEGIN
  220.                 WRITE(LST,#27,'M');
  221.                 WRITE(' 12 CPI');
  222.               END;
  223.          IF PitchParam='PS' THEN           {Select PS}
  224.               BEGIN
  225.                  WRITE(LST,#27,#112,#1);
  226.                  WRITE(' Proportional');
  227.               END;
  228.    END;{SelectPitch}
  229.  
  230. {**************************************************************************}
  231. {**********************             MAIN            ***********************}
  232. {**************************************************************************}
  233. BEGIN{Program SLASH0}
  234.  
  235.   CheckBreak:=FALSE;
  236.  
  237. {           <<<< Get Parameters and convert to uppercase >>>>              }
  238.   IF PARAMCOUNT<5 THEN
  239.     BEGIN
  240.       FOR i:=1 TO PARAMCOUNT DO
  241.         BEGIN
  242.           Param[i]:=PARAMSTR(i);
  243.           Param[i]:=UpperCase(Param[i]);
  244.         END;
  245.     END;
  246.  
  247. {  <<<< If first parameter=Help then call for help >>>>  }
  248.   IF (COPY(Param[1],1,1)='H') THEN Help;
  249.  
  250.  
  251. {              <<<<  Too many parameters: Error >>>>                       }
  252.   IF PARAMCOUNT>4 THEN {too many parameters}
  253.      BEGIN
  254.        Sound(800);Delay(500);NoSound;
  255.        WRITELN('Too many parameters - a maximum of four is allowed:'#10,#13);
  256.        ErrorMessage;
  257.      END;
  258.  
  259. {                    <<<<    Set Defaults  >>>>                            }
  260.   IF PARAMCOUNT=0 THEN
  261.      BEGIN
  262.         Param[1]:='D';
  263.         Param[2]:='12';
  264.         Param[3]:='N';
  265.         Param[4]:='1.0'
  266.      END;
  267.  
  268.   IF PARAMCOUNT=1 THEN
  269.     BEGIN
  270.        Param[2]:='12';     {no parameter2 so set default  to 12}
  271.        Param[3]:='N';      { " parameter3  "  "    "      "  N }
  272.        Param[4]:='1.0';    { " parameter4  "   "   "      "  1 }
  273.     END;
  274.  
  275.   IF PARAMCOUNT= 2 THEN    {no parameter3 or parameter 4 so set defaults}
  276.      BEGIN
  277.        Param[3]:='N';
  278.        Param[4]:='1.0';
  279.      END;
  280.  
  281.   IF PARAMCOUNT=3 THEN   {get the N/C parameter and the }
  282.                          { margin parameter into the proper variable}
  283.      BEGIN
  284.        IF (COPY(Param[3],1,1)>='A') AND (COPY(Param[3],1,1)<='z') THEN
  285.          BEGIN  {Param[3] is not a number}
  286.            Param[4]:='1.0';   {set default margin}
  287.          END;
  288.        {If Param[3] is a number then adjust Param[3] and Param[4]}
  289.        IF ((COPY(Param[3],1,1)>'/') AND (COPY(Param[3],1,1) < ':'))
  290.          OR
  291.           (COPY(Param[3],1,1)='.')
  292.            THEN
  293.              BEGIN
  294.                Param[4]:=Param[3]; {place left margin in Param[4]}
  295.                Param[3]:='N';      {set default to N}
  296.             END;
  297.       END;
  298.  
  299. {  <<<< Convert Param[2](the margin in inches) from string to integer >>> }
  300. {          <<<< Convert margin  from inches to characters >>>>            }
  301.      VAL(Param[4],InMargin,Result);
  302.        Margin:=InMargin*10;
  303.  
  304. {                     <<<< Screen Display >>>>                            }
  305.  
  306.   WRITELN;
  307.   WRITELN('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');
  308.   WRITELN('SLASH0.EXE   Version 1.1                       by Ed Weber  c1989');
  309.   WRITELN('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');
  310.   WRITELN;
  311.  
  312.  
  313.  
  314.   TestPrinter;                     {Is the printer turned on?}
  315.  
  316.   CheckParam(Param[1],Param[2],Param[3],Param[4],ROUND(Margin));
  317.                                              {check validity of parameters}
  318.  
  319.   WRITE(LST,#27,'@');                    {initialize the printer}
  320.   write(lst,#27,#108,CHR(ROUND(Margin)));
  321.  
  322.   IF Param[1] = 'D' THEN Draft;            {Process Draft}
  323.  
  324.   IF Param[1] = 'S' THEN                   {Process Sans Serif}
  325.      BEGIN{Sans Serif}
  326.        WRITE('Sans Serif');
  327.         WRITE(LST,#27,'x',#1);           {select LQ}
  328.         WRITE(LST,#27,'k',#1);           {select Sans Serif}
  329.         SelectPitch(Param[2]);           {process Param[2]}
  330.         WRITE(LST,#27,':',#0,#1,#0);     {ROM to RAM}
  331.      LetterQual;                         {call the data FOR LQ zero}
  332.   END;{Sans Serif}
  333.  
  334.   IF Param[1] = 'R'THEN                    {Roman}
  335.     BEGIN{Roman}
  336.        WRITE('Roman');
  337.        WRITE(LST,#27,'x',#1);            {select LQ}
  338.        WRITE(LST,#27,'k',#0);            {select Roman}
  339.        SelectPitch(Param[2]);
  340.        WRITE(LST,#27,':',#0,#0,#0);      {ROM to RAM}
  341.        LetterQual;
  342.   END;{Roman}
  343.  
  344.   IF Param[3]='C' THEN                     {condensed}
  345.      BEGIN
  346.         WRITE(LST,#15);
  347.         WRITE(' Condensed');
  348.       END;
  349.  
  350.   IF Param[3]='N' THEN                     {normal}
  351.      BEGIN
  352.        WRITE(LST,#16);
  353.      END;
  354.  
  355.   WRITELN(' slashed zero character downloaded.');{announce results}
  356.   WRITELN('Left Margin is set to ',Param[4],' inches.');
  357.   IF PARAMCOUNT=0 THEN {remind user about getting help}
  358.     BEGIN
  359.       WRITELN('Defaults for all parameters were used.');
  360.       WRITELN('For parameter information, type SLASH0 HELP and press <ENTER>.');
  361.     END;
  362.   WRITE(LST,#27,'%',#1);  {activate RAM character set}
  363.  
  364. END.{Program Slash0}        {******ALL DONE******}
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.